home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 114 / 114.d81 / slide poker (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  9KB  |  289 lines
  1. 10 poke56,56:poke51,0:clr:dv=peek(186):ifdv<8thendv=8
  2. 14 sys36867,"slide scores"
  3. 20 dimi,x,y,su,et,el,ps,lv,lf,pp,mt,s,f,ca,va,t,jj,j%
  4. 30 bd=14:hl=6:sk=14:poke16383,31
  5. 40 gosub300
  6. 50 goto1640
  7. 67 :
  8. 68 :rem getkey
  9. 69 :
  10. 70 gosub210
  11. 80 fori=1tolen(ch$):ifa$=mid$(ch$,i,1)thenreturn
  12. 90 next:goto70
  13. 178 :rem error channel
  14. 179 :
  15. 180 open15,dv,15:input#15,er,er$,a,a:close15
  16. 182 return
  17. 197 :
  18. 198 :rem press key prompt
  19. 199 :
  20. 200 poke214,22:print:print"            press a key          [145][145][145]"
  21. 210 geta$:ifa$=""then250:return
  22. 227 :
  23. 228 :rem print at
  24. 229 :
  25. 230 poke211,x:poke214,y:sys58732:return
  26. 237 :
  27. 238 :rem multitask shuffle
  28. 239 :
  29. 250 ifjj=nc-2thenjj=-1
  30. 260 jj=jj+1:j%=jj+int(rnd(0)*(nc-jj)):temp=s(jj):s(jj)=s(j%):s(j%)=temp:goto210
  31. 277 :
  32. 278 :rem erase card
  33. 279 :
  34. 280 sysmt+3,x,x+3,y,y+4,00,sk:return
  35. 297 :
  36. 298 :rem initialize
  37. 299 :
  38. 300 dimva$(13),vb$(13),st$(4,12),op(15),s(54)
  39. 301 dimb(13,1),dk(54),x(13),y(13),c(13),hd(13),fs(3),fl(7),ph(15,6)
  40. 302 f=54272:fori=ftof+78:pokei,0:next:mt=52224
  41. 304 pokef+1,50:pokef+24,12:pokef+5,128
  42. 310 cr$="[216][203][202][201][200][199][198][197][196]&[195][194][217]":cs$="[204][215][214][213][212][211][210][209][208]'[207][206][205]"
  43. 320 s$(0)="[162]":s$(1)="[173]":s$(2)="[192]":s$(3)="[193]":co$(0)="[144]":co$(1)="":co$(2)=""
  44. 330 co$(3)="[144]":s1$(0)="[161]":s1$(1)="[218]":s1$(2)="[223]":s1$(3)="[176]"
  45. 340 fori=0to12:va$(i)=mid$(cr$,i+1,1):vb$(i)=mid$(cs$,i+1,1):next
  46. 350 bk$="!##$[157][157][157][157]#[190][190]#[157][157][157][157]#[190][190]#[157][157][157][157]#[190][190]#[157][157][157][157]\++*[157][157][157][157][145][145][145][145]"
  47. 352 jk$="!##$[157][157][157][157]#[186][187]#[157][157][157][157]#[188][189]#[157][157][157][157]#[190][191]#[157][157][157][157]\++*[157][157][157][157][145][145][145][145]"
  48. 360 deffns(x)=int(x/13):deffnv(x)=x-13*int(x/13)
  49. 377 :
  50. 378 :rem first shuffle
  51. 379 :
  52. 380 nc=53:jj=-1:fori=0tonc-1:s(i)=i:next
  53. 390 jj=jj+1:j%=jj+int(rnd(0)*(nc-jj)):temp=s(jj):s(jj)=s(j%):s(j%)=temp
  54. 400 ifjj<>nc-2then390
  55. 407 :
  56. 408 :rem define cards
  57. 409 :
  58. 410 st$(0,1)="[215][216][157][157][217][218][146]":st$(0,0)="[211][212][146]":st$(3,0)="[179][180][146]"
  59. 420 st$(0,9)="[193][194][157][157][195][196][157][157][197][198][157][157][199][200][157][157][201][202][146]":st$(3,2)="[183][184][157][157][179][180][157][157][185][186][146]"
  60. 430 st$(0,8)="[193][194][157][157][203][204][157][157][205][206][157][157][207][208][157][157][201][202][146]":st$(0,3)="[193][194][157][157][201][202][146]"
  61. 440 st$(3,8)="[161][162][157][157][171][172][157][157][173][174][157][157][175][176][157][157][169][170][146]":st$(0,7)="[193][194][157][157][211][212][157][157][209][210][157][157][213][214][157][157][201][202][146]"
  62. 450 st$(3,9)="[161][162][157][157][163][164][157][157][165][166][157][157][167][168][157][157][169][170][146]":st$(3,7)="[161][162][157][157][179][180][157][157][177][178][157][157][181][182][157][157][169][170][146]"
  63. 460 st$(3,1)="[183][184][157][157][185][186][146]":st$(0,2)="[215][216][157][157][211][212][157][157][217][218][146]"
  64. 470 st$(0,6)="[193][194][157][157][211][212][157][157][209][210][157][157][201][202][146]":st$(3,6)="[161][162][157][157][179][180][157][157][177][178][157][157][169][170][146]"
  65. 480 st$(3,3)="[161][162][157][157][169][170][146]":st$(0,5)="[193][194][157][157][209][210][157][157][201][202][146]"
  66. 490 st$(3,5)="[161][162][157][157][177][178][157][157][169][170][146]":st$(0,4)="[193][194][157][157][211][212][157][157][201][202][146]"
  67. 500 st$(3,4)="[161][162][157][157][179][180][157][157][169][170][146]":
  68. 510 st$(2,9)="ab[157][157]cd[157][157]ef[157][157]gh[157][157]ij":st$(2,8)="ab[157][157]kl[157][157]mn[157][157]op[157][157]ij"
  69. 520 st$(2,7)="ab[157][157]st[157][157]qr[157][157]uv[157][157]ij":st$(2,6)="ab[157][157]st[157][157]qr[157][157]ij"
  70. 530 st$(2,5)="ab[157][157]qr[157][157]ij":st$(2,4)="ab[157][157]st[157][157]ij":st$(2,3)="ab[157][157]ij"
  71. 540 st$(2,2)="wx[157][157]st[157][157]yz":st$(2,1)="wx[157][157]yz":st$(2,0)="st"
  72. 550 fori=2to3:forj=10to12:st$(i,j)="01[157][157]23[157][157]45[157][157]67[157][157]89":next:next
  73. 560 st$(1,9)="[219][220][157][157][187][188][157][157][223][191][157][157][189][190][157][157][221][255][146]"
  74. 570 st$(1,8)="[219][220][157][157]#$[157][157]%&[157][157]*+[157][157][221][255][146]"
  75. 580 st$(1,6)="[219][220][157][157]\^[157][157]<>[157][157][221][255][146]"
  76. 590 st$(1,5)="[219][220][157][157]<>[157][157][221][255][146]"
  77. 600 st$(1,4)="[219][220][157][157]\^[157][157][221][255][146]"
  78. 610 st$(1,7)="[219][220][157][157]\^[157][157]<>[157][157]_=[157][157][221][255][146]"
  79. 620 st$(1,1)="[166][167][157][157][168][169]":st$(1,2)="[166][167][157][157]\^[146][157][157][146][168][169]"
  80. 630 st$(1,0)="\^[146]":st$(1,3)="[219][220][157][157][221][255][146]"
  81. 640 fori=0to3:st$(i,11)="()[157][157]>?[157][157]45[157][157]<=[157][157]:;":next
  82. 650 st$(0,10)="()[157][157]^_[157][157]45[157][157][][157][157]:;"
  83. 660 st$(1,10)="()[157][157]^_[157][157]45[157][157][][157][157]:;"
  84. 670 st$(1,12)="01[157][157]23[157][157]45[157][157]67[157][157]89"
  85. 680 st$(0,12)="()[157][157]^_[157][157]45[157][157][][157][157]:;"
  86. 690 st$(2,12)="()[157][157]^_[157][157]45[157][157][][157][157]:;"
  87. 700 st$(3,12)="()[157][157]^_[157][157]45[157][157][][157][157]:;"
  88. 717 :
  89. 718 :rem card locations
  90. 719 :
  91. 730 fori=1to4:y(i)=2:x(i)=8*i-2:next:fori=10to13:y(i)=16:x(i)=8*i-74:next
  92. 740 fori=5to9:y(i)=9:x(i)=8*i-38:next:x(0)=1:y(0)=15
  93. 747 :
  94. 748 :rem slide numbers
  95. 749 :
  96. 750 forj=1to14:fori=1to3:readph(j,i):next:next
  97. 752 data1,6,11,2,7,12
  98. 760 data2,6,10,3,8,13
  99. 770 data3,7,11,4,8,12,0,0,0,0,0,0
  100. 780 data10,6,2,11,7,3
  101. 790 data11,6,1,12,8,4
  102. 800 data12,7,2,13,8,3
  103. 810 fori=1to5:ph(7,i)=i+4:ph(8,i)=10-i:next
  104. 817 :
  105. 818 :rem oops pairs
  106. 819 :
  107. 820 fori=1to14:readop(i):next
  108. 822 data11,13,9,14,10,12,8,7,3,5,1,6,2,4
  109. 830 ms$(0)="five of a kind   120"
  110. 840 ms$(1)="royal flush      100"
  111. 850 ms$(2)="straight flush   80"
  112. 860 ms$(3)="four of a kind   60
  113. 870 ms$(4)[178]"full house       40"
  114. 880 ms$(5)[178]"flush            30"
  115. 890 ms$(6)[178]"straight         20"
  116. 900 ms$(7)[178]"three of a kind  15"
  117. 910 ms$(8)[178]"two pair         10"
  118. 920 ms$(9)[178]"a pair           5"
  119. 930 ms$(10)[178]"bust hand        0"
  120. 940 [142]
  121. 957 :
  122. 958 :[143] print or erase card
  123. 959 :
  124. 960 x[178]x(i):y[178]y(i):[141]230
  125. 970 ca[178]b(i,c(i))
  126. 980 su[178][165]s(ca):va[178][165]v(ca)
  127. 990 [151]f[170]4,129:[129]t[178]1[164]15:[130]:[151]f[170]4,128:[151]f[170]5,0
  128. 1010 [139]su[178]4[167]1070
  129. 1020 [139]c(i)[179][177]0[167]1050
  130. 1040 [141]280:[142]:[143] erase card
  131. 1050 [153]co$(su);va$(va);"<<>cmdcmdcmdcmd";s$(su);"  ^cmdcmdcmdcmdtab(  ^cmdcmdcmdcmdtab(  ";s1$(su);
  132. 1060 [153]"cmdcmdcmdcmdsgn==";vb$(va);"ononononcmdcmdcmd";st$(su,va);:[142]
  133. 1070 [153]jk$:[142]
  134. 1080 :
  135. 1088 :[143] move em out
  136. 1089 :
  137. 1090 [129]m[178]1[164]np:tp(m)[178]b(ph(z,m),1):[130]:nr[178]nr[170]1
  138. 1100 [129]m[178]1[164]np[171]1:b(ph(z,m[170]1),1)[178]tp(m):[130]:b(ph(z,1),1)[178]tp(np)
  139. 1110 i[178]ph(z,1):c(i)[178]0:[141]960:[129]m[178]2[164]np:i[178]ph(z,m)
  140. 1120 c(i)[178]0:[141]960:[143] pick it up
  141. 1130 c(i)[178]1:[141]960:[130]:[143] place it
  142. 1140 i[178]ph(z,1):c(i)[178]1:[141]960:[142]
  143. 1150 :
  144. 1158 :[143] score hand
  145. 1159 :
  146. 1160 [129]i[178]0[164]12:hd(i)[178]0:[130]:[129]i[178]0[164]3:fs(i)[178]0:[130]:[129]i[178]1[164]7:fl(i)[178]0:[130]:wc[178]0
  147. 1170 [129]i[178]5[164]9:[139]b(i,1)[177]51[167]wc[178]1:[137]1190
  148. 1180 fc[178]b(i,1):hd([165]v(fc))[178]hd([165]v(fc))[170]1:fs([165]s(fc))[178]fs([165]s(fc))[170]1
  149. 1190 [130]
  150. 1200 [129]i[178]0[164]3:[139]fs(i)[170]wc[178]5[167]fl(1)[178]1
  151. 1210 [130]
  152. 1220 m[178]0: [129]i[178]0[164]8:[139]hd(i)[177]0[167]1250
  153. 1230 m[178]i[170]1
  154. 1240 [130]
  155. 1250 zc[178]0:[129]i[178]m[164]m[170]4:[139]hd(i)[178]0[167]1270
  156. 1260 zc[178]zc[170]1
  157. 1270 [130]:[139]zc[170]wc[178]5[167]fl(6)[178]1
  158. 1280 rk[178]0:[139]hd(0)[178]1[167]rk[178]1
  159. 1290 [129]i[178]9[164]12:[139]hd(i)[179][177]1[167]1310
  160. 1300 rk[178]rk[170]1
  161. 1310 [130]
  162. 1320 [139]rk[170]wc[178]5[167]fl(6)[178]2
  163. 1330 [129]i[178]0[164]12:[139]hd(i)[178]2[167]fl(2)[178]fl(2)[170]1
  164. 1340 [139]hd(i)[178]